home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / pcl / cl-nd-cl.lha / clue / clio / text-command.lisp < prev    next >
Lisp/Scheme  |  1990-07-19  |  3KB  |  62 lines
  1. ;;; -*- Mode:Lisp; Package:CLIO-OPEN; Base:10; Lowercase:T; Syntax:Common-Lisp -*-
  2.  
  3.  
  4. ;;;----------------------------------------------------------------------------------+
  5. ;;;                                                                                  |
  6. ;;;                          TEXAS INSTRUMENTS INCORPORATED                          |
  7. ;;;                                  P.O. BOX 149149                                 |
  8. ;;;                             AUSTIN, TEXAS 78714-9149                             |
  9. ;;;                                                                                  |
  10. ;;;             Copyright (C) 1990, 1990 Texas Instruments Incorporated.             |
  11. ;;;                                                                                  |
  12. ;;; Permission is granted to any individual or institution to use, copy, modify, and |
  13. ;;; distribute this software, provided that  this complete copyright and  permission |
  14. ;;; notice is maintained, intact, in all copies and supporting documentation.        |
  15. ;;;                                                                                  |
  16. ;;; Texas Instruments Incorporated provides this software "as is" without express or |
  17. ;;; implied warranty.                                                                |
  18. ;;;                                                                                  |
  19. ;;;----------------------------------------------------------------------------------+
  20.  
  21. (in-package "CLIO-OPEN")
  22.  
  23. (export '(
  24.       text-command-table
  25.       text-command
  26.       make-text-command-table
  27.       )
  28.     'clio-open)
  29.  
  30. ;;;----------------------------------------------------------------------------+
  31. ;;;                                                                            |
  32. ;;;                            text-command-table                              |
  33. ;;;                                                                            |
  34. ;;;----------------------------------------------------------------------------+
  35.  
  36. (deftype text-command-table () 'hash-table)
  37.  
  38. (defmacro text-command (text-command-table char)
  39.   `(gethash ,char ,text-command-table))
  40.  
  41.  
  42. (defun make-text-command-table (&rest commands)
  43.   "Return a new text-command-table containing the given COMMANDS.
  44. COMMANDS is a plist of the form ([char command]*), where command is
  45. either a functionp object or a list of the form (function . args)."
  46.  
  47.   (let* ((initial-size (floor (length commands) 2))
  48.      (table        (make-hash-table :size initial-size)))
  49.     (do ()
  50.     ((endp commands))
  51.       (let ((char    (first commands))
  52.         (command (second commands)))
  53.     (assert command nil "No command given for ~a." char)
  54.     
  55.     (setf (text-command table char) command)
  56.  
  57.     (setf commands (cddr commands))))
  58.     table)) 
  59.  
  60.  
  61.  
  62.